;;;; -*- Mode: Lisp; Package: dreaming-tree; -*-
;;;;
;;;; sdl-renderer
;;;;
;;;; OpenGL application using SDL.

(in-package :dreaming-tree)
(defparameter *active-sdl-thread* nil)
(defparameter *the-view* nil)
(defparameter *the-scene* nil)
(defparameter *the-camera* nil)


(defun kill-active-sdl-thread ()
  (when *active-sdl-thread*
    (ccl:process-kill *active-sdl-thread*)
    (setq *active-sdl-thread* nil)))

(defclass sdl-renderer (renderer)
  ((screen          :accessor renderer-screen     :initarg :screen)
   (screen-width    :accessor screen-width        :initarg :screen-width    :initform 640)
   (screen-height   :accessor screen-height       :initarg :screen-height   :initform 480)
   (make-active-p   :accessor make-active-p       :initarg :make-active     :initform nil)
   (show-debug-info :accessor show-debug-info     :initarg :show-debug-info :initform t)
   (threaded        :accessor threaded            :initarg :threaded        :initform nil))
  (:default-initargs
   :scene nil))

(defmethod initialize-instance :after ((view sdl-renderer) &rest initargs)
  (declare (ignore initargs))
  (with-slots (scene) view
    (setf scene (make-instance 'scene-manager :camera (make-instance 'action-camera))
	  (culling-camera (scene-culler scene)) (scene-camera scene)))
  (when (make-active-p view)
    (make-renderer-active view)))

(defmethod make-renderer-active ((view sdl-renderer))
  (if *active-sdl-thread* 
      (progn
	(setf *the-view* view)
	(resize-canvas view (screen-width view) (screen-height view)))
      (if (threaded view)
	  (setf *active-sdl-thread* (ccl:process-run-function "SDL Opengl" #'sdl-main-loop view))
	  (sdl-main-loop view))))

(defmethod application-time ((view sdl-renderer))
  (animation-time view))

(defmethod load-texture ((view sdl-renderer) source &optional name)
  (let ((tex (make-instance 'texture-arb :source source)))
    (if name
	(setf (gethash name (textures view)) tex)
	(setf (gethash source (textures view)) tex))))

;;; Event Processing

(defun alt-key-p ()
  (or (sdl:key-held-p :sdl-key-lalt)
      (sdl:key-held-p :sdl-key-ralt)))

(defun ctrl-key-p ()
  (or (sdl:key-held-p :sdl-key-rctrl)
      (sdl:key-held-p :sdl-key-lctrl)))

(defun shift-key-p ()
  (or (sdl:key-held-p :sdl-key-lshift)
      (sdl:key-held-p :sdl-key-rshift)))

(defun make-default-camera ()
  (make-instance 'action-camera))

(defmethod move-camera ((view renderer))
  (with-slots (current-key-event) view
    (when current-key-event
      (case current-key-event
	(:sdl-key-a (pan-left view)) ; a
	(:sdl-key-s (pan-up view)) ; s
	(:sdl-key-d (pan-right view)) ; d
	(:sdl-key-w (pan-down view))) ; w
      (setf (culler-update-p view) t))))

(defmethod resize-canvas ((r sdl-renderer) width height)
  (with-slots (screen-width screen-height scene) r
    (setf screen-width width
	  screen-height height)
    (let ((screen-ratio (coerce (/ screen-width screen-height) 'double-float)))
      (setf (camera-aspect (scene-camera scene)) screen-ratio)
      (gl:viewport 0 0 width height))))

(defmethod prepare-opengl ((r sdl-renderer))
  (with-slots (screen-width screen-height scene) r
    ;;(compile-and-link-all-shaders r)
    (gl:clear-color 0.2 0.2 0.22 1.0)
    (gl:clear-depth 1.0d0)
    (gl:shade-model :smooth)
    ;;(gl:enable :texture-2d)
    ;;(gl:enable :depth-test)
    ;;(gl:depth-func :lequal)
    ;;(gl:hint :perspective-correction-hint :nicest)
    (resize-canvas r screen-width screen-height)
    (update-projection (scene-camera scene))))

;;(import 'lispbuilder-sdl-cffi::sdl-pressed)
(defun mouse-button-event (renderer button state x y)
  ;(format t "** Mouse button event ~A ~A ~A ~A.~%" button state x y)
  (declare (ignore state))
  (case button
    (3 (generate-pick-ray renderer x y))
    (4 (move-back (renderer-scene renderer) 0.05))
    (5 (move-forward (renderer-scene renderer) 0.05))))

(defmethod process-key-event ((r scene-manager) key)
  (case key
    (:sdl-key-w (pan-up r 0.01))
    (:sdl-key-a (pan-left r 0.01))
    (:sdl-key-d (pan-right r 0.01))
    (:sdl-key-s (pan-down r 0.01))))

(defparameter *default-listener-port* 4885)

(defun sdl-main-loop (view)
  (declare (special *the-view* *the-scene*))
  (sdl:with-init ()
    ()
    (with-slots (screen-width screen-height) view
      (setf %gl::*gl-get-proc-address* #'sdl::sdl-gl-get-proc-address)
      (let* ((win (sdl:window screen-width screen-height
			      :opengl t
			      :title-caption "Test Scene"
			      :icon-caption "Test Scene"
			      :opengl-attributes '((:sdl-gl-doublebuffer 1))
			      :fps (make-instance 'sdl:fps-timestep)))
	     (camera (scene-camera (renderer-scene view))))
	(setf *the-view* view
	      *the-scene* (renderer-scene view)
	      *the-camera* (scene-camera (renderer-scene view))
	      (renderer-screen view) win)
	(prepare-opengl *the-view*)
	(sdl:enable-key-repeat 100 10)
	;;#+swank (swank:create-server :port *default-listener-port* :dont-close t :coding-system "utf-8")
	(sdl:with-events ()
	  (:quit-event () (progn (kill-active-sdl-thread)
				 ;#+swank (swank:stop-server *default-listener-port*) 
				 t))
	  (:key-down-event (:key key)
			   (case key
			     (:SDL-KEY-ESCAPE (sdl:push-quit-event))
			     (:sdl-key-r (reset-camera *the-camera*))
			     
			     (t (process-key-event *the-scene* key))))
	  (:video-resize-event (:w new-width :h new-height)
			       (resize-canvas *the-view* new-width new-height))
	  (:key-up-event (:key key)
			 (declare (ignore key))
			 (setf (current-key-event *the-view*) nil))
	  (:mouse-button-up-event (:button button :state state :x x :y y)
				  (mouse-button-event *the-view* button state x y))
	  (:mouse-motion-event (:state state :x-rel xrel :y-rel yrel)
			       ;(format t "Mouse motion state=~A" state)
			       (cond ((eql state 4)
				      (pan-camera *the-scene* xrel yrel 0.05))))
	  (:idle ()
		 (setf (current-timestep *the-view*) (sdl::dt)
		       (current-time *the-view*) (sdl::ticks))
		 (gl:clear :color-buffer-bit :depth-buffer-bit)
		 ;; (when (show-debug-info *the-view*)
		 ;;   (sdl:with-color (sdl:*white* nil nil)
		 ;;     (sdl:with-default-font (sdl:*font-8x8*)
		 ;;       (sdl:with-surface ((sdl:create-surface (screen-width *the-view*)
		 ;; 					      (screen-height *the-view*)) nil nil)
		 ;; 	 (sdl:draw-string-solid (format nil "Frame rate: ~A" (sdl:average-fps)) #(0 0))))))
		 (sdl:with-timestep 
		   ;;Physics update here!
		   ;;(controller-update *the-view*)
		   )
		 (update-view camera)
		 (draw-scene *the-view* *the-scene*)
		 ;(sdl-cffi::sdl-gl-swap-buffers)
		 (sdl:update-display)))))))

(defmethod draw-scene ((canvas sdl-renderer) (scene scene-manager))
  (if (null (scene-root scene))
      (%draw-default-scene)
      (dolist (o (determine-visible-set scene))
	(draw o)))) ;; (draw o canvas)?

(defun %draw-default-scene ()
  (let ((triangle (gllib:new-vertex-list :format '(:|v3f| :|c3f|)
					 :data (list #2A((0.0 1.0 0.0)
							 (-1.0 -1.0 0.0)
							 (1.0 -1.0 0.0))
						     #2A((1.0 0.0 0.0)
							 (0.0 1.0 0.0)
							 (0.0 0.0 1.0)))
					 :indices #(0 1 2)
					 :mode :triangles))
	(quad (gllib:new-vertex-list :format '(:|v3f| :|c3f|)
				     :data '(((-1.0 1.0 0.0)
					      (1.0 1.0 0.0)
					      (1.0 -1.0 0.0)
					      (-1.0 -1.0 0.0))
					     ((0.5 0.5 1.0)
					      (0.5 0.5 1.0)
					      (0.5 0.5 1.0)
					      (0.5 0.5 1.0)))
				     :indices '(0 1 2 3)
				     :mode :quads))
	(box (make-box #(6.0 0.0 0.0))))
    (unless (gethash 'crate (textures *the-view*))
      (log5:log-for (log5:lib.gl) "Loading crate texture.")
      (load-texture *the-view* "~/Crate.bmp" 'crate))
    ;;(lib.gl::%draw-text-simple "Hello world!" (make-transform))
    (gl:translate -1.5 0.0 -0.0)
    (gllib::draw-vertex-list triangle)
    (gl:translate 3.0 0.0 0.0)
    (enable-texture (gethash 'crate (textures *the-view*)))
    (gllib::draw-vertex-list quad)
    (disable-texture (gethash 'crate (textures *the-view*)))
    (gl:translate -6.0 0.0 0.0)
    (gllib::draw-vertex-list (vertex-attrib-object box))))

;;;; ======== ;;;;

;;; Some examples from cl-opengl
#|
(defclass shader-vao-window (renderer)
  ((vbuff :accessor vertex-buffer)
   (ibuff :accessor index-buffer)
   (vs :accessor vertex-shader)
   (fs :accessor fragment-shader)
   (va :accessor vertex-array)
   (program :accessor program)
   (angle :accessor angle :initform 0.0)) 
  (:default-initargs :width 500 :height 500 :pos-x 100 :pos-y 100
		     :mode '(:double :rgb :depth) :title "shader-vao.lisp"
		     :tick-interval (round 1000 60)))

(defvar *shader-vao-vertex-program*
  "#version 330

// The location is 0 because that's the vertex attribute we associate with vertex positions.
layout (location = 0) in vec3 in_Position;

uniform mat4 projectionMatrix;
uniform float angle;

// This is interpolated and used in the fragment shader.
smooth out vec2 pos;

void main()
{
  mat2 rotationMatrix = mat2(cos(angle), sin(angle), -sin(angle), cos(angle));
  float scaleFactor = 1.0 + 0.5 * sin(1.75 * angle);
  vec2 vertPos = scaleFactor * rotationMatrix * in_Position.xy;
  pos = vertPos * 5.0;

  gl_Position = projectionMatrix * vec4(vertPos, 0.0, 1.0); 
} 
")

(defvar *shader-vao-fragment-program*
  "#version 330

out vec4 out_Color;
smooth in vec2 pos;

uniform float angle;

void main() 
{
  mat2 rotationMatrix = mat2( cos(angle), sin(angle), -sin(angle), cos(angle) );
  vec2 rpos = mod(rotationMatrix * pos, 2.0 );
  
  if ((rpos.x > 1.0 && rpos.y > 1.0 ) || (rpos.x < 1.0 && rpos.y < 1.0))
    out_Color = vec4(0.1, 0.1, 0.1, 1.0); 
  else
    out_Color = vec4(0.5, 0.5, 0.7, 1.0);
} 
")

;;; Initialization 

;;; First, we create buffers for our vertex and index
;;; data. Then, we create the vertex array object that we actually use
;;; for rendering directly. Finally, we load the shader objects.

(defmethod glut:display-window :before ((w shader-vao-window))
  ;; An array buffer can be used to store verex position, colors,
  ;; normals, or other data. We need to allocate an GL array, copy the
  ;; data to the array, and tell OpenGL that the buffers data comes
  ;; from this GL array. Like most OpenGL state objects, we bind the
  ;; buffer before we can make changes to its state.
  (let ((buffers (gl:gen-buffers 2)))
    (setf (vertex-buffer w) (elt buffers 0)
	  (index-buffer w) (elt buffers 1)))
  (gl:bind-buffer :array-buffer (vertex-buffer w))
  (let ((arr (gl:alloc-gl-array :float 12))
	(verts #(-0.5 -0.5 0.0 
		 -0.5 0.5 0.0 
		 0.5 -0.5 0.0 
		 0.5 0.5 0.0)))
    (dotimes (i (length verts))
      (setf (gl:glaref arr i) (aref verts i)))
    (gl:buffer-data :array-buffer :static-draw arr)
    (gl:free-gl-array arr))

  ;; 0 is always reserved as an unbound object.
  (gl:bind-buffer :array-buffer 0)

  ;; An element array buffer stores vertex indices. We fill it in the
  ;; same way as an array buffer.
  (gl:bind-buffer :element-array-buffer (index-buffer w))
  (let ((arr (gl:alloc-gl-array :unsigned-short 6))
	(indexes #(0 2 1 1 2 3)))
    (dotimes (i (length indexes))
      (setf (gl:glaref arr i) (aref indexes i)))
    (gl:buffer-data :element-array-buffer :static-draw arr)
    (gl:free-gl-array arr))
  (gl:bind-buffer :element-array-buffer 0)

  ;; Vertex array objects manage which vertex attributes are
  ;; associated with which data buffers. 
  (setf (vertex-array w) (gl:gen-vertex-array))
  (gl:bind-vertex-array (vertex-array w))

  ;; To associate our VBO data with this VAO, we bind it, specify
  ;; which vertex attribute we want to associate it with, and specify
  ;; where the data comes from.
  (gl:bind-buffer :array-buffer (vertex-buffer w))
  ;; In this program, we use attribute 0 for position. If you had
  ;; per-vertex normals, you could use a different attribute for those
  ;; as well.
  (gl:enable-vertex-attrib-array 0)
  ;; Using a null pointer as the data source indicates that we want
  ;; the vertex data to come from the currently bound array-buffer.
  (gl:vertex-attrib-pointer 0 3 :float nil 0 (cffi:null-pointer))

  ;; To associate an element array with this VAO, all we need to do is
  ;; bind the element array buffer we want to use.
  (gl:bind-buffer :element-array-buffer (index-buffer w))

  ;; Once we're done, we can unbind the VAO, and rebind it when we want to render it.
  (gl:bind-vertex-array 0)

  ;; A program object is a collection of shader objects to be used
  ;; together in a single pipeline for rendering objects. To create a
  ;; program, you first create the individual shaders. Then you attach
  ;; the shaders to the program and link the program together.
  (let ((vs (gl:create-shader :vertex-shader))
	(fs (gl:create-shader :fragment-shader)))
    (setf (vertex-shader w) vs)
    (setf (fragment-shader w) fs)
    (gl:shader-source vs *shader-vao-vertex-program*)
    (gl:compile-shader vs)
    (gl:shader-source fs *shader-vao-fragment-program*)
    (gl:compile-shader fs)
    ;; If the shader doesn't compile, you can print errors with:
    ;; (print (gl:get-shader-info-log vs))
    ;; (print (gl:get-shader-info-log fs))

    (setf (program w) (gl:create-program))
    ;; You can attach the same shader to multiple different programs.
    (gl:attach-shader (program w) vs)
    (gl:attach-shader (program w) fs)
    ;; Don't forget to link the program after attaching the
    ;; shaders. This step actually puts the attached shader together
    ;; to form the program.
    (gl:link-program (program w))
    ;; If we want to render using this program object, or add
    ;; uniforms, we need to use the program. This is similar to
    ;; binding a buffer.
    (gl:use-program (program w))))

(defmethod glut:tick ((w shader-vao-window))
  (let ((seconds-per-revolution 6)) 
    (incf  (angle w)
	   (/ (* 2 pi) (* 60 seconds-per-revolution))))
  (gl:uniformf (gl:get-uniform-location (program w) "angle") (angle w))
  (glut:post-redisplay))

(defmethod glut:display ((w shader-vao-window))
  (gl:clear-color 0.0 0.0 0.2 1.0)
  (gl:clear :color-buffer-bit :depth-buffer-bit)
  
  ;; Since we never use any other program object, this is unnecessary
  ;; in this program. Typically, though, you'll have multiple program
  ;; objects, so you'll need to 'use' each one to activate it.
  (gl:use-program (program w))
  (gl:bind-vertex-array (vertex-array w))
  
  ;; This call actually does the rendering. The vertex data comes from
  ;; the currently-bound VAO. If the input array is null, the indices
  ;; will be taken from the element array buffer bound in the current
  ;; VAO.
  (gl:draw-elements :triangles (gl:make-null-gl-array :unsigned-short) :count 6)

  (glut:swap-buffers))

(defmethod glut:reshape ((w shader-vao-window) width height)
  (gl:viewport 0 0 width height)
  (gl:matrix-mode :projection)
  (gl:load-identity)
  ;; Ensure that projection matrix ratio always matches the window size ratio,
  ;; so the polygon will always look square.
  (let ((right (max (float (/ width height)) 1.0))
	(top (max (float (/ height width)) 1.0)))
    (glu:ortho-2d (- right) right (- top) top))
  (when (program w)
      (let ((proj-mat (gl:get-float :projection-matrix)))
	(gl:uniform-matrix 
	 (gl:get-uniform-location (program w) "projectionMatrix") 
	 4 
	 (vector proj-mat))))
  (gl:matrix-mode :modelview)
  (gl:load-identity))

(defmethod glut:keyboard ((w shader-vao-window) key x y)
  (declare (ignore x y))
  (case key
    (#\Esc (glut:leave-main-loop))))

;; Cleanup.
;; Most of the objects we created have analogous deletion function.
(defmethod glut:close ((w shader-vao-window))
  ;; Note: It doesn't matter whether we delete the program or the
  ;; linked shaders first. If a shader is linked to a program, the
  ;; shader isn't destroyed until after the program is
  ;; destroyed. Similarly, if the program is destroyed, the shaders
  ;; are detached.
  (gl:delete-shader (vertex-shader w))
  (gl:delete-shader (fragment-shader w))
  (gl:delete-program (program w))

  (gl:delete-buffers (list (vertex-buffer w) (index-buffer w)))
  (gl:delete-vertex-arrays (list (vertex-array w))))

(defun shader-vao ()
  (let ((w (make-instance 'shader-vao-window)))
    (unwind-protect
	 (glut:display-window w)
      (glut:destroy-window (glut:id w)))))

|#
